perm filename CALL.TNX[TNX,AIL] blob
sn#119914 filedate 1974-09-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TENX <
C00004 00003 ACTUAL EMULATING CODE LIVES HERE
C00007 00004 SIX1: PUSHJ P,SAVE
C00010 00005
C00011 00006 DEFINE CALTBL <
C00012 00007 IFN ALWAYS,<BEND UTILS>
C00013 00008
C00014 ENDMK
C⊗;
TENX <
DSCR
TENEX VERSION OF THE DEC CALL FUNCTION
EXTERNALS USED HERE: CVSIX,OUTSTR,.SKIP.,X22,ZSETST,ZADJST,
CHRCAT,CAT,CATCHR,RUNPRG
⊗
HERE(CALL)
DEFINE CALARG <-5(P)> ;WHERE THE ARGUMENT IS AT
BEGIN CALL
PUSH P,2 ;SAVE THESE ACS
PUSH P,3
PUSH P,4
PUSH P,5
PUSH SP,-1(SP)
PUSH SP,-1(SP)
PUSHJ P,CVSIX ;GET SIXBIT (BUT LEAVE STRING ON STACK)
MOVSI 2,-CALTSZ
CALLUP: CAMN 1,CAL6TB(2)
JRST @CALDTB(2) ;FOUND THE ROUTINE
AOBJN 2,CALLUP
;CANNOT FIND THE CALL IN THE TABLE
PUSH SP,-1(SP) ;PRINT OUT THE OFFENDING NAME
PUSH SP,-1(SP)
PUSHJ P,OUTSTR
ERR <
CALL: ABOVE CALL NOT EMULATED BY SAIL>,1
SETZ 1,
JRST CALRET ;RETURN IF USER INSISTS
CALRES: SETOM .SKIP. ;HERE TO SKIP RETURN
SKIPA
CALRET: SETZM .SKIP.
POP P,5
POP P,4
POP P,3
POP P,2
SUB SP,X22
SUB P,X22
JRST @2(P)
;ACTUAL EMULATING CODE LIVES HERE
..EXIT: JSYS HALTF
JRST CALRET
..DATE: SETO 2, ;CURRENT TIME AND DATE
SETZ 4, ;GET YEAR, MONTH, DAY
JSYS ODCNV
HLRZ 1,2 ;YEAR
SUBI 1,=1964
IMULI 1,=12 ;(YEAR-1964)*12
ADDI 1,(2) ;(YEAR-1964)*12+(MONTH-1)
IMULI 1,=31 ;...*31
HLRZ 3,3
ADDI 1,(3) ;+ (DAY-1)
ANDI 1,7777 ;12 BITS ONLY
JRST CALRET ;AND RETURN
..TIMER: SKIPA 5,[=60]
..MSTIME: MOVEI 5,=1000
SETO 2,
SETZ 4,
JSYS ODCNV
MOVEI 1,(4) ;SECONDS SINCE MIDNIGHT
IMUL 1,5
JRST CALRET ;NOW RETURN
..RUNTIM:
SKIPE CALARG ;JOB MENTIONED?
JRST USESGT ;YES
MOVNI 1,5 ;ALL FORKS OF THE JOB
JSYS RUNTM
JRST CALRET
USESGT: MOVE 1,[SIXBIT/TICKPS/]
JSYS SYSGT
MOVE B,A
HRLZ A,CALARG
HRRI A,1
JSYS GETAB
SETZ A, ;ERROR
JUMPGE A,.+2 ;POSITIVE NO. IS OK
SETZ A, ;NEGATIVE NO. IS NO SUCH JOB
USESG1: JRST CALRET ;NOW RETURN
..PJOB: JSYS GJINF
MOVE 1,3 ;JOB NUMBER
JRST CALRET
..LOGOUT:
SETO 1,
JSYS LGOUT
JRST CALRET
..GETPPN:
JSYS GJINF
PUSH P,[=100]
PUSHJ P,ZSETST
JSYS DIRST ;DIR NO IN 2, STRING BP IN 1
ERR <CALL&GETPPN: CANNOT DO DIRST>;ERROR RETURN
PUSH P,[=100] ;COUNT -- SEE ABOVE
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST ;GET STRING ON SP STACK
PUSHJ P,CVSIX ;GET SIXBIT, ADJUST STACK
JRST CALRET
SIX1: PUSHJ P,SAVE
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,6
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
PUSH SP,[0] ;COUNT WORD
PUSH SP,TOPBYTE(USER)
MOVEI A,6 ;READ AT MOST 6 CHARS
MOVE B,[POINT 6,-1(P)]
MOVEI C,0 ;COUNT CHARS ACTUALLY DONE
SIX2: ILDB TEMP,B
JUMPE TEMP,SIX3 ;NULL?
ADDI TEMP,40 ;MAKE INTO 7-BIT
IDPB TEMP,TOPBYTE(USER)
AOJ C, ;ANOTHER CHAR ADDED
SIX3: SOJG A,SIX2
HRROM C,-1(SP) ;COUNT WORD
SUBI C,6 ;SET TO
ADDM C,REMCHR(USER) ;ADJUST REMCHR
MOVE LPSA,X22
JRST RESTR
..RUN: MOVE 1,CALARG
MOVE 2,(1) ;DEVICE SIXBIT
CAMN 2,[SIXBIT/SYS/] ;DEVICE SYS?
JRST USESYS ;YES
CAME 2,[SIXBIT/DSK/] ;BETTER BE DSK
JRST CALRET ;NO, RETURN TO USER
SKIPN 4(1) ;ANY PPN MENTIONED?
JRST [PUSH P,1(1) ;USER NAME IN 6-BIT
PUSHJ P,CVXSTR ;GET A STRING IN 7-BIT
JRST RUNNAM]
PUSH P,["<"]
PUSH P,4(1) ;PPN
PUSHJ P,SIX1 ;GET 7-BIT STRING
PUSHJ P,CHRCAT ;<DIR
PUSH P,[">"]
PUSHJ P,CATCHR ;<DIR>
JRST GOTDIR
USESYS: PUSH SP,[=8]
PUSH SP,[POINT 7,[ASCIZ/<SUBSYS>/]]
GOTDIR: PUSH P,1(1) ;NAME
PUSHJ P,SIX1 ;TO 7-BIT
PUSHJ P,CAT ;<DIR>NAME
RUNNAM: PUSH SP,[4]
PUSH SP,[POINT 7,[ASCIZ/.SAV/]]
PUSHJ P,CAT ;<DIR>NAME.SAV
HLRZ 1,1 ;THE INCREMENT
PUSH P,1
PUSH P,[0] ;DONT WANT A NEW FORK
PUSHJ P,RUNPRG
JRST CALRET ;ERROR RETURN
;CODE FOR IMSSS-SPECIFIC CALLIS
IMSSS<
..DATSAV:
MOVE 1,CALARG
JSYS DATSV
JRST CALRET
JRST CALRES
..PUTINF:
SETO 1,
MOVE 2,CALARG
JSYS PTINF
ERR <CALL: PUTINF HAS FAILED>,1
JRST CALRET
..GETINF:
SETO 1,
MOVE 2,CALARG
JSYS GTINF
ERR <CALL: GETINF HAS FAILED>,1
JRST CALRET
..RANDOM:
JSYS RAND ;GET RANDOM NO. IN 1 AND 2
JRST CALRET
>;IMSSS
DEFINE CALTBL <
CZ EXIT
CZ DATE
CZ LOGOUT
CZ TIMER
CZ MSTIME
CZ GETPPN
CZ RUNTIM
CZ PJOB
CZ RUN
IMSSS<
CZ DATSAV
CZ PUTINF
CZ GETINF
CZ RANDOM
>
>
DEFINE CZ $ (X) <SIXBIT/$X$/>
CAL6TB: CALTBL
CALTSZ←←.-CAL6TB+1
DEFINE CZ $ (X) <..$X>
CALDTB: CALTBL
BEND CALL
ENDCOM(COD)
;END OF TENEX CODE FOR THE CALL FUNCTION
IFN ALWAYS,<BEND UTILS>
SUBTTL STRING HANDLING ROUTINES
>;TENX